home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v7n21.arc
/
COPY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-11-14
|
3KB
|
88 lines
PROGRAM Copy;
CONST
BufSize = 16384;
VAR
ioCode : Byte;
SrcFile, DstFile : FILE;
FileNameA, FileNameB : STRING[255];
Buffer : ARRAY[1..BufSize] OF Byte;
RecsRead : Integer;
DiskFull : Boolean;
PROCEDURE SrcFileError(ioCode : Byte);
BEGIN
Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);
CASE ioCode OF
$01 : WriteLn(' Source file not found.');
$F3 : WriteLn(' Too many files open.');
ELSE WriteLn(' "Reset" unknown I/O error.');
END;
END;
PROCEDURE DstFileError(ioCode : Byte);
BEGIN
Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);
CASE ioCode OF
$F0 : WriteLn(' Disk data area full.');
$F1 : WriteLn(' Disk directory full.');
$F3 : WriteLn(' Too many files open.');
ELSE WriteLn(' "Rewrite" unknown I/O error.');
END;
END;
BEGIN
Write('Copy from file : ');
ReadLn(FileNameA);
Write(' To file : ');
ReadLn(FileNameB);
IF FileNameB <> FileNameA THEN
BEGIN
Assign(SrcFile, FileNameA);
Assign(DstFile, FileNameB);
{* Note second parameter in "reset" and "rewrite" of UNtyped files. *}
{$I-} Reset(SrcFile, 1); {$I+}
ioCode := IOResult;
IF ioCode <> 0 THEN SrcFileError(ioCode)
ELSE
BEGIN
{$I-} Rewrite(DstFile, 1); {$I+}
ioCode := IOResult;
IF ioCode <> 0 THEN DstFileError(ioCode)
ELSE
BEGIN
DiskFull := False;
WHILE (NOT EoF(SrcFile)) AND (NOT DiskFull) DO
BEGIN
{* Note fourth parameter in "blockread". *}
{$I-}
BlockRead(SrcFile, Buffer, BufSize, RecsRead);
{$I+}
ioCode := IOResult;
IF ioCode <> 0 THEN
BEGIN
SrcFileError(ioCode);
DiskFull := True
END
ELSE
BEGIN
{$I-}
BlockWrite(DstFile, Buffer, RecsRead);
{$I+}
ioCode := IOResult;
IF ioCode <> 0 THEN
BEGIN
DstFileError(ioCode);
DiskFull := True
END
END
END;
IF NOT DiskFull THEN WriteLn('File copied.')
END;
Close(DstFile)
END;
Close(SrcFile)
END
ELSE WriteLn(#7, 'File can not be copied onto itself.')
END.